Este modelo abarca el período de tiempo desde 2019 hasta julio de 2024.
Se bajan los datos
ruta_productos <- "/cloud/project/df_dif.xlsx"
excel_sheets(ruta_productos)
## [1] "Sheet 1"
productos <- as.data.frame(read_xlsx(ruta_productos, sheet = "Sheet 1", col_names = T))
productos <- select(.data = productos, c("Fecha", "dif"))
colnames(productos) <- c("Fecha", "Totales")
head(productos)
## Fecha Totales
## 1 2019-07-03 -2.8586186
## 2 2019-07-04 0.6996184
## 3 2019-07-05 0.8669633
## 4 2019-07-06 0.1055037
## 5 2019-07-08 0.5360249
## 6 2019-07-09 -1.4721819
nrow(productos)
## [1] 694
productos_diaria_ts <- ts(data = productos$Totales,start = 2019, frequency = 365)
productos_diaria_xts <- xts(productos$Totales,
order.by = productos$Fecha, frequency = 365)
urca::ur.df(productos_diaria_ts)
##
## ###############################################################
## # Augmented Dickey-Fuller Test Unit Root / Cointegration Test #
## ###############################################################
##
## The value of the test statistic is: -31.8151
El valor del estadístico de Dickey-Fuller es -31.8151 Este resultado, significativamente menor que el valor crítico, nos permite rechazar la hipótesis nula de que la serie tiene una raíz unitaria a un nivel de significancia del 5%. En consecuencia, concluimos que la serie de tiempo es estacionaria.
kpss.test(productos_diaria_ts)
## Warning in kpss.test(productos_diaria_ts): p-value greater than printed p-value
##
## KPSS Test for Level Stationarity
##
## data: productos_diaria_ts
## KPSS Level = 0.0071219, Truncation lag parameter = 6, p-value = 0.1
KPSS Level = 0.0071219, Truncation lag parameter = 6, p-value = 0.1 Ho:La serie de tiempo es estacionaria. Ha:La serie de tiempo no es estacionaria. Dado que el valor p es 0.1, mayor al nivel de significancia convencional de 0.05, no se rechaza la hipótesis nula. plot(decompose(productos_diaria_ts))
ggAcf(productos_diaria_ts, col = "red", lag.max = 20)
ggPacf(productos_diaria_ts, col = "blue", lag.max = 10)
dividida_diaria_ts <- ts_split(productos_diaria_ts,
sample.out = round(length(productos_diaria_ts)*0.2))
entrena_productos_diaria_ts <- dividida_diaria_ts$train
prueba_productos_diaria_ts <- dividida_diaria_ts$test
modelo_prod_dia <- auto.arima(entrena_productos_diaria_ts,
seasonal = F,
stepwise = F)
summary(modelo_prod_dia )
## Series: entrena_productos_diaria_ts
## ARIMA(1,0,2) with zero mean
##
## Coefficients:
## ar1 ma1 ma2
## 0.6993 -1.7055 0.7170
## s.e. 0.2279 0.2235 0.2197
##
## sigma^2 = 3.002: log likelihood = -1092.41
## AIC=2192.82 AICc=2192.89 BIC=2210.1
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE ACF1
## Training set -0.005123487 1.727887 1.386558 -Inf Inf 0.5031373 0.008331805
# AIC=2192.82 AICc=2192.89 BIC=2210.1
# ARIMA(1,0,2) with zero mean
checkresiduals(modelo_prod_dia, col = "red") # p-value = 0.9631
##
## Ljung-Box test
##
## data: Residuals from ARIMA(1,0,2) with zero mean
## Q* = 83.235, df = 108, p-value = 0.9631
##
## Model df: 3. Total lags used: 111
pronostico_diaria_prod <- forecast(modelo_prod_dia ,
h = length(prueba_productos_diaria_ts),
level = 0.95)
plot(prueba_productos_diaria_ts[1:50],type = "l", col = "green", ylab = "Valores",
lwd = 2)
lines(pronostico_diaria_prod$fitted[1:50], type = "l", col = "darkorange")
lines(pronostico_diaria_prod$mean[1:50], type = "l", col = "darkred", lwd = 2, lty = 2)
legend("bottomleft", legend = c("prueba", "ajustado", "pronostico"),
fill = c("green", "darkorange", "darkred"), cex = 0.6, lty = c(1,1,2))
accuracy(prueba_productos_diaria_ts, pronostico_diaria_prod$mean)
## ME RMSE MAE MPE MAPE ACF1
## Test set 0.004529374 2.21399 1.660474 5.432005e+22 1.820467e+23 -0.3524233
## Theil's U
## Test set 2.125549e+22
# ME RMSE MAE MPE MAPE ACF1
#Test set 0.004529374 2.21399 1.660474 5.432005e+22 1.820467e+23 -0.3524233
accuracy(prueba_productos_diaria_ts[1:50], pronostico_diaria_prod$mean[1:50])
## ME RMSE MAE MPE MAPE
## Test set -0.0003449083 2.051954 1.682708 187142070 9726194525
# ME RMSE MAE MPE MAPE
# Test set -0.0003449083 2.051954 1.682708 187142070 9726194525
El pronóstico determinado por el modelo esuna linea media de los valores, en este caso con valor nulo. Este modelo esta muy por debajo del mejor modelo que es el RML.